home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / fdispPopup.tcl.z / fdispPopup.tcl
Text File  |  2002-07-08  |  10KB  |  341 lines
  1. #
  2. # fdispPopup.tcl
  3. #
  4. # Nested folder popup (or popdown) display.
  5. #
  6. # Copyright (c) 1993 Xerox Corporation.
  7. # Use and copying of this software and preparation of derivative works based
  8. # upon this software are permitted. Any distribution of this software or
  9. # derivative works must comply with all applicable United States export
  10. # control laws. This software is made available AS IS, and Xerox Corporation
  11. # makes no warranty about the software, its performance or its conformity to
  12. # any specification.
  13.  
  14. # Reset notion of displayed popdowns when canvas is init'd or destroyed
  15. proc FdispPopdownReset {} {
  16.     global fdisp
  17.     set fdisp(poptop) -1
  18. }
  19. # Remove all displayed popdowns
  20. proc FdispPopdownRemove {} {
  21.     FdispDisplayPopdown "" remove
  22. }
  23. proc FdispDisplayPopdown {folder pop {bx -1} {by -1}} {
  24.     global fdisp
  25.  
  26.     set can canvas    ;# popdowns only on main display
  27.  
  28.     set folderSet [Flist_FolderSet $folder]
  29.     set canvas $fdisp($can)
  30.     set width [winfo width $canvas]
  31.  
  32.     if ![info exists fdisp(maxy,canvas)] {
  33.     return    ;# display not initialized yet
  34.     }
  35.     case $fdisp(popdownStyle) in {
  36.     {r*}    {set style 1}
  37.     default    {set style 0}
  38.     }
  39.     set tag T_$folder
  40.  
  41.     #Exmh_Debug FdispDisplayPopdown $folder $pop top=$fdisp(poptop) $tag
  42.     if {($pop == "down") && ($fdisp(poptop) != -1)} {
  43.     if {$fdisp(popdown,0) == $tag} {
  44.         # Clicking on a folder with popup already displayed.
  45.         set pop "remove"
  46.     }
  47.     }
  48.     if {($pop == "stack") && ($fdisp(popdown,$fdisp(poptop)) == $tag) &&
  49.     ($fdisp(popdownAction) == "navbutton")} {
  50.     Exmh_Debug Remove leaf $tag
  51.     $canvas lower $fdisp(popdown,$fdisp(poptop))
  52.     incr fdisp(poptop) -1
  53.     return
  54.     }
  55.  
  56.     if {$pop == "stack"} {
  57.     if {$fdisp(popdownAction) == "navbutton"} {
  58.         set hit 0
  59.         for {set i 0} {$i <= $fdisp(poptop)} {incr i} {
  60.         if {$fdisp(popdown,$i) == $tag} {
  61.             set hit 1    ;# Already visible.  Decide what to nuke.
  62.         }
  63.         }
  64.         if {$hit} {
  65.         for {set i $fdisp(poptop)} {$i >= 0} {incr i -1} {
  66.             Exmh_Debug remove popdown $fdisp(popdown,$i)
  67.             $canvas lower $fdisp(popdown,$i)
  68.             incr fdisp(poptop) -1
  69.             if {$fdisp(popdown,$i) == $tag} {
  70.             return
  71.             }
  72.         }
  73.         }
  74.     }
  75.     if {$fdisp(popdown,$fdisp(poptop)) == $tag} {
  76.         Exmh_Debug "Reuse top of stack $tag"
  77.         FdispPopupView $canvas $tag
  78.         return
  79.     }
  80.     for {set i 0} {$i <= $fdisp(poptop)} { incr i} {
  81.         if {$fdisp(popdown,$i) == $tag} {
  82.         Exmh_Debug popdown already visible $tag
  83.         FdispPopupView $canvas $tag
  84.         return
  85.         }
  86.     }
  87.     incr fdisp(poptop)
  88.     } else {
  89.     for {set i $fdisp(poptop)} {$i >= 0} {incr i -1} {
  90.         Exmh_Debug remove popdown $fdisp(popdown,$i)
  91.         $canvas lower $fdisp(popdown,$i)
  92.     }
  93.     if {$pop == "remove"} {
  94.         FdispPopupResetView $can
  95.         set fdisp(poptop) -1
  96.         return
  97.     }
  98.     set fdisp(poptop) 0
  99.     }
  100.  
  101.     if {[$canvas gettag $tag] != ""} {
  102.     set fdisp(popdown,$fdisp(poptop)) $tag
  103.     Exmh_Debug reuse popdown $tag
  104.     $canvas raise $tag
  105.     FdispPopupView $canvas $tag
  106.     return
  107.     }
  108.  
  109.     Exmh_Status "Building popdown display for $folder"
  110.  
  111.     set bid [FdispGetBmap $can $folder]
  112.     if {$bid == ""} {
  113.     set id [$canvas find closest $bx $by]
  114.     Exmh_Debug CLOSEST: x=$bx y=$by is id=$id [$canvas type $id]
  115.  
  116.     if {[$canvas type $id] == "text"} {
  117.         set bid [$canvas find below $id]
  118.         Exmh_Debug bid=$bid [$canvas type $bid] @ [$canvas coo $bid]
  119.     } else {
  120.         set bid $id
  121.     }
  122.     }
  123.  
  124.     set bbox [$canvas coords $bid]
  125.     if {[string length $bbox] == 0} {
  126.     Exmh_Status "No coords for box <$bid>" error
  127.     return
  128.     }
  129.  
  130.     # compute bounding coords of anchoring folder name/bitmap
  131.     #    bx1,by1
  132.     #       +-----------+
  133.     #        |folder name|
  134.     #       +-----------+
  135.     #             bx2,by2
  136.  
  137.     set bx1 [lindex $bbox 0]
  138.     set bx2 [lindex $bbox 2]
  139.     set by1 [lindex $bbox 1]
  140.     set by2 [lindex $bbox 3]
  141.  
  142.     # layout subfolder display
  143.     #    will be centered around anchor with a width equal to 3/4 of canvas
  144.     FdispLayoutInner $can 0 0 [expr ($width*3/4)] $folderSet $folder \
  145.         FdispBindPopupLabel skipSelf $tag
  146.  
  147.     # compute bounding coords of subfolder display
  148.     #    wid = width, hei = height
  149.     #    lx = left x, rx = right x
  150.     # lx/rx are adjusted to fit within width of canvas (wid is not updated)
  151.  
  152.     if [catch {
  153.     set bbox1 $bbox
  154.     set bbox [$canvas bbox $tag]
  155.     set hei [expr $fdisp(ygap)/2 + [lindex $bbox 3] - [lindex $bbox 1]]
  156.     set wid [expr $fdisp(xgap)/4 + [lindex $bbox 2] - [lindex $bbox 0]]
  157.     set wid [expr {$wid - $bx2 + $bx1}]
  158.  
  159.     set lx [expr $bx1-$wid/2]
  160.     set rx [expr $bx2+4+$wid/2]
  161.     } err] {
  162.     global errorInfo ; set savedInfo $errorInfo
  163.     catch {set wid} w
  164.     error $err "Bbox1=($bbox1) Bbox2=($bbox) wid=$w bx1=$bx1 bx2=$bx2\n$savedInfo"
  165.     }
  166.     if {$lx < 3} {
  167.     set rx [expr {$rx - $lx + 3}]
  168.     set lx 3
  169.     }
  170.     if {$rx > $width - 4} {
  171.     set lx [expr {$width + $lx - $rx - 4}]
  172.     set rx [expr $width-4]
  173.     }
  174.  
  175.     if {$style} {
  176.     set gap 4
  177.  
  178.     # Add a square decoration around subfolder display
  179.     #
  180.     #    bx1,by1
  181.     #       +-----------+
  182.     #       |folder name|
  183.     #       +-----------+ bx2,by2         +
  184.     # rx1,ry1                             | gap
  185.     #    +-----------------+              +
  186.     #    |subfolder display|
  187.     #    +-----------------+ rx2,ry2
  188.  
  189.     set rx1 $lx
  190.     set ry1 [expr $by2+$gap]
  191.     set rx2 $rx
  192.     set ry2 [expr {$ry1 + $fdisp(ygap)/4+$hei}]
  193.  
  194.     set loweredge [expr {$ry2 + 4}]
  195.  
  196.     set box [$canvas create rect $rx1 $ry1 $rx2 $ry2 -fill $fdisp(c_popup)]
  197.  
  198.     $canvas move $tag [expr {$rx1 + $fdisp(xgap)*3/4}] \
  199.             [expr {$ry1 + $fdisp(ygap)/2}]
  200.     $canvas raise $tag $box
  201.  
  202.     $canvas addtag $tag withtag $box
  203.     } else {
  204.     set gap 14
  205.  
  206.     # Add a trapezoidal decoration around subfolder display
  207.     #
  208.     #    bx1,by1
  209.     #       +-----------+
  210.     #       |folder name|
  211.     #       +-----------+ bx2,by2         + +
  212.     # px1,py1                             | | 2 pixels
  213.     #       +-----------+ px2,py2         | +
  214.     #      /             \                |
  215.     #     /               \               | gap
  216.     #    +px6,py6          + px3,py3      +
  217.     #    |subfolder display|
  218.     #    +-----------------+ px4,py4
  219.     # px5,py5
  220.  
  221.     set px1 $bx1
  222.     # +2 makes us overlap the lower black border
  223.     set py1 [expr $by2+2]
  224.     set px2 [expr $bx2+4]
  225.     set py2 $py1
  226.     set px3 $rx
  227.     set py3 [expr $by2+$gap]
  228.     set px4 $px3
  229.     set py4 [expr {$py3 + $fdisp(ygap)/4+$hei}]
  230.     set px5 $lx
  231.     set py5 $py4
  232.     set px6 $px5
  233.     set py6 $py3
  234.  
  235.     set loweredge [expr {$py4 + 4}]
  236.  
  237.     set border [$canvas create poly $px1 $py1 $px2 $py2 \
  238.             $px3 $py3 $px4 $py4 \
  239.             $px5 $py5 $px6 $py6 -fill $fdisp(c_fg)]
  240.  
  241.     set box [$canvas create poly [expr $px1+1] [expr $py1+1] \
  242.             [expr $px2-1] [expr $py2+1] \
  243.             [expr $px3-1] [expr $py3+1] \
  244.             [expr $px4-1] [expr $py4-1] \
  245.             [expr $px5+1] [expr $py5-1] \
  246.             [expr $px6+1] [expr $py6+1] \
  247.             -fill $fdisp(c_popup)]
  248.  
  249.     $canvas move $tag [expr {$px6 + $fdisp(xgap)*3/4}] \
  250.             [expr {$py6 + $fdisp(ygap)/2}]
  251.     $canvas raise $tag $box
  252.  
  253.     # add a dividing line
  254.     # (should just change above poly to be a poly and a rect)
  255.     # set line [$canvas create line $px6 $py6 $px3 $py6]
  256.     # $canvas raise $line
  257.     # $canvas addtag $tag withtag $line
  258.  
  259.     $canvas addtag $tag withtag $border
  260.     $canvas addtag $tag withtag $box
  261.     }
  262.     # Cannot bind to <Leave> because that triggers when you enter a label.
  263.     $canvas bind $box <Double-$fdisp(navbutton)> \
  264.     [list FdispDisplayPopdown {} remove]
  265.  
  266.     FdispSetCanvasSize $can $loweredge 1
  267.  
  268.     Exmh_Status ""
  269.     set fdisp(popdown,$fdisp(poptop)) $tag
  270.     FdispPopupView $canvas $tag
  271.     # Highlight newly created labels
  272.     Fdisp_HighlightCanvas canvas
  273. }
  274. proc FdispBindPopupLabel { can id ftype f } {
  275.     global fdisp
  276.     set canvas $fdisp($can)
  277.     if {[string compare $ftype hasNested] == 0} {
  278.     # This label has nested folders
  279.     case $fdisp(popdownAction) {
  280.         redisplay {
  281.         $canvas bind $id <$fdisp(navbutton)> \
  282.             [list FdispMain $f]
  283.         }
  284.         enter {
  285.         $canvas bind $id <Any-Enter> \
  286.             [list FdispDisplayPopdown $f stack %x %y]
  287.         }
  288.         navbutton {
  289.         $canvas bind $id <$fdisp(navbutton)> \
  290.             [list FdispDisplayPopdown $f stack %x %y]
  291.         }
  292.     }
  293.     }
  294.     $canvas bind $id <$fdisp(curbutton)> [list Folder_Change $f]
  295.  
  296.     if {$fdisp(tarbuttonAction) == "select+move"} {
  297.         $canvas bind $id <$fdisp(tarbutton)> \
  298.                 [list Folder_TargetMove $f]
  299.     } elseif {$fdisp(tarbuttonAction) == "select+copy"} {
  300.         $canvas bind $id <Shift-$fdisp(tarbutton)> \
  301.                 [list Folder_TargetCopy $f]
  302.     } elseif {$fdisp(tarbuttonAction) == "select only"} {
  303.         $canvas bind $id <$fdisp(tarbutton)> \
  304.                 [list Folder_Target $f]
  305.     } else {
  306.         $canvas bind $id <$fdisp(tarbutton)> \
  307.                 [list Folder_TargetMove $f]
  308.     }
  309.     $canvas bind $id <Shift-$fdisp(tarbutton)>     [list Folder_TargetCopy $f]
  310.     $canvas bind $id <Control-$fdisp(tarbutton)> \
  311.             [list Folder_TargetClear]
  312. }
  313. proc FdispPopupResetView { can } {
  314.     global fdisp
  315.     set canvas $fdisp($can)
  316.     if {$fdisp(popdownRemove) == "navbutton" || \
  317.         [$canvas canvasy 0] > $fdisp(maxy,$can)} {
  318.         $canvas yview moveto 0.
  319.     }
  320. }
  321. proc FdispPopupView { canvas tag } {
  322.     $canvas raise $tag
  323.     set h [lindex [$canvas configure -height] 4]
  324.     if [catch {$canvas cget -yscrollincrement} inc] {
  325.     set inc [expr [$canvas cget -height]/10]
  326.     }
  327.     set ybot [$canvas canvasy $h]
  328.     set bbox [$canvas bbox $tag]
  329.     set popbot [lindex $bbox 3]
  330.     if {$popbot <= $ybot} {return}
  331.  
  332.     # Bottom edge clipped
  333.     set moveup [expr $popbot-$ybot]
  334.  
  335.     set ytop [$canvas canvasy 0]
  336.     set poptop [lindex $bbox 1]
  337.     set room [expr $poptop-$ytop]
  338.     set moveup [expr {($moveup > $room || $poptop == $inc+1) ? $room-2*$inc : $moveup}]
  339.     $canvas yview scroll [expr int($moveup/$inc)] units
  340. }
  341.